home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / MPW_TOOL / TOOLS / TOOLS_WI / ICON_8 / TESTS / VERSION7.ICN < prev    next >
Text File  |  1990-03-02  |  6KB  |  209 lines
  1.  
  2.  
  3. procedure main ()
  4.  
  5.    write(&host)
  6.    write(&version)
  7.    write("&line=",&line)
  8.    write("&file=",&file)
  9.    write("&error=",&error)
  10.    every write(&features)
  11.  
  12. # show results of bitwise operations on various operand combinations
  13.  
  14.    every i := 1 | '2' | "3" do {
  15.       write (
  16.        "    i        j       ~j      i & j    i | j    i ^ j   i << j   i >> j")
  17.       every j := 0 | 1 | 2 | 3 | 4 | 100 do {
  18.          write(right(i,8), right(j,9))
  19.          word (i)
  20.          word (j)
  21.          word (icom (j))
  22.          word (iand (i, j))
  23.          word (ior (i, j))
  24.          word (ixor (i, j))
  25.          word (ishift (i, j))
  26.          word (ishift (i, -j))
  27.          write ()
  28.          }
  29.       }
  30.  
  31. # test remove() and rename(), and print errors in case of malfunction
  32.  
  33.    name1 := "temp1"
  34.    name2 := "temp2"
  35.    data := "Here's the data"
  36.  
  37.    every remove (name1 | name2)        # just in case
  38.    open (name1) & stop ("can't remove ", name1, " to initialize test")
  39.    open (name2) & stop ("can't remove ", name2, " to initialize test")
  40.    remove (name1) & stop ("successfully removed nonexistent file")
  41.    rename (name1, name2) & stop ("successfully renamed nonexistent file")
  42.  
  43.    f := open (name1, "w") | stop ("can't open ",name1," for write")
  44.    write (f, data)
  45.    close (f)
  46.  
  47.    f := open (name1) | stop ("can't open ",name1," after write")
  48.    s := read (f) | ""
  49.    close(f)
  50.    s == data | stop ("data lost after write")
  51.  
  52.    rename (name1, name2) | stop ("can't rename(",name1,",",name2,")")
  53.    f := open (name2) | stop ("can't open ",name2," after rename")
  54.    s := read (f) | ""
  55.    close(f)
  56.    s == data | stop ("data lost after rename")
  57.  
  58.    remove (name1) & stop ("remove succeeded on file already renamed")
  59.    remove (name2) | stop ("can't remove renamed file")
  60.    open (name1) & stop (name1, " still around at end of test")
  61.    open (name2) & stop (name2, " still around at end of test")
  62.  
  63. #  test seek() and where()
  64.  
  65.    f := open("concord.dat")
  66.    write(image(seek(f,11)))
  67.    write(where(f))
  68.    write(image(reads(f,10)))
  69.    write(where(f))
  70.    write(where(f))
  71.    seek(f,-2)
  72.    write(where(f))
  73.    write(image(reads(f,1)))
  74.    write(where(f))
  75.  
  76. # test ord() and char(), and print messages if wrong results
  77.  
  78.    s := string (&cset)
  79.    every i := 0 to 255 do {
  80.       c := char (i)
  81.       n := ord (c)
  82.       if n ~= i | c ~== s[i+1] then
  83.      write ("oops -- ord/char failure at ",i)
  84.    }
  85.    if char("47") ~== char(47) then
  86.       write ("oops -- type conversion failed in char()")
  87.    if ord(9) ~= ord("9") then
  88.       write ("oops -- type conversion failed in ord()")
  89.  
  90.    every ferr (char, -65536 | -337 | -1 | 256 | 4713 | 65536 | 123456, 205)
  91.    every ferr (char, "abc" | &lcase | &errout | [], 101)
  92.    every ferr (ord, "" | "ab" | "antidisestablishmentarianism" | 47, 205)
  93.    every ferr (ord, &output | table(), 103)
  94.  
  95. #  test getenv()
  96.  
  97.    write(getenv("HOME") | write("getenv failed"))
  98.    write(getenv("foo") | write("getenv failed"))
  99.  
  100. #  test sorting
  101.  
  102.    a := list(1)        # different sizes to make identification easy
  103.    b := list(2)
  104.    c := list(3)
  105.    d := list(4)
  106.    e := &lcase ++ &ucase
  107.    f := &lcase ++ &ucase
  108.    g := '123456789'
  109.    h := &digits
  110.    A := sort([h,g,a,c,b,d,f,e,&lcase,[],&cset,&ascii])
  111.    every write(image(!A))
  112.  
  113. # test varargs
  114.  
  115.    write("p(1):")
  116.    p(1)
  117.    write("p(1, 2):")
  118.    p(1, 2)
  119.    write("p(1, 2, 3):")
  120.    p(1, 2, 3)
  121.    write("p(1, 2, 3, 4, 5):")
  122.    p(1, 2, 3, 4, 5)
  123.    write("q(1, 2):")
  124.    q(1, 2)
  125.  
  126. # test Version 7 table features
  127.  
  128.    write("t := table(\"default\") --> ", image(t := table("default")) |
  129.       "failure")
  130.    show(t)
  131.    write("insert(t, 3, 4) --> ", image(insert(t, 3, 4)) | "failure")
  132.    write("insert(t, \"xyz\", \"abc\") --> ", image(insert(t, "xyz", "abc")) |
  133.       "failure")
  134.    write("insert(t, &digits) --> ", image(insert(t, &digits)) | "failure")
  135.    show(t)
  136.    write("t[\"xyz\"] := \"new value\" --> ", image(t["xyz"] := "new value") |
  137.       "failure")
  138.    show(t)
  139.    write("insert(t, \"xyz\", \"def\") --> ", image(insert(t, "xyz", "def")) |
  140.       "failure")
  141.    show(t)
  142.    write("delete(t, \"xyz\") -- > ", image(delete(t, "xyz")) | "failure")
  143.    show(t)
  144.    write("delete(t, \"xyz\") -- > ", image(delete(t, "xyz")) | "failure")
  145.    show(t)
  146.  
  147. #  test run-time error mechanism
  148.  
  149.    &error := 1
  150.    runerr(101)
  151.    write("&errornumber=", &errornumber | "no value")
  152.    write("&errortext=", &errortext | "no value")
  153.    write("&errorvalue=", &errorvalue | "no value")
  154.    runerr(701,"abc")
  155. end
  156.  
  157. # write word in hexadecimal
  158. procedure word (v)
  159.    xd (v, 8)
  160.    writes (" ")
  161.    return
  162.    end
  163.  
  164. # write n low-order hex digits of v
  165. procedure xd (v, n)
  166.    xd (ishift (v, -4), 0 < n - 1)
  167.    writes ("0123456789ABCDEF" [1 + iand (v, 16r0F)])
  168.    return
  169.    end
  170. # ferr(func,val,err) -- call func(val) and verify that error "err" is produced
  171.  
  172. procedure ferr (func, val, err)
  173.    msg := "oops -- " || image(func) || "(" || image (val) || ") "
  174.    &error := 1
  175.    if func (val)
  176.       then write (msg, "succeeded")
  177.    else if &error ~= 0
  178.       then write (msg, "failed but no error")
  179.    else if &errornumber ~= err
  180.       then write (msg, "got error ",&errornumber," instead of ",err)
  181.    &error := 0
  182.    return
  183. end
  184.  
  185. procedure p(a, b, c[])
  186.    write("   image(a):", image(a))
  187.    write("   image(b):", image(b))
  188.    write("   image(c):", image(c))
  189.    write("   every write(\"\\t\", !c):")
  190.    every write("\t", !c)
  191. end
  192.  
  193. procedure q(a[])
  194.    write("   every write(\"\\t\", !a):")
  195.    every write("\t", !a)
  196. end
  197. procedure show(t)
  198.    local x
  199.  
  200.    write("   *t --> ", *t)
  201.    write("   t[\"xyz\"] --> ", image(t["xyz"]) | "failure")
  202.    write("   member(t, \"xyz\") --> ", image(member(t, "xyz")) | "failure")
  203.    x := sort(t, 3)
  204.    write("   contents of t:")
  205.    while writes("\t", image(get(x)), " : ")
  206.       do write(image(get(x)))
  207.    write("")
  208. end
  209.